home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / scheme / pcscheme / geneva / sources.exe / SOURCES / EDWIN / CHARSET.S < prev    next >
Encoding:
Text File  |  1993-06-15  |  4.0 KB  |  122 lines
  1. ;;;
  2. ;;;    Copyright (c) 1985 Massachusetts Institute of Technology
  3. ;;;
  4. ;;;    This material was developed by the Scheme project at the
  5. ;;;    Massachusetts Institute of Technology, Department of
  6. ;;;    Electrical Engineering and Computer Science.  Permission to
  7. ;;;    copy this software, to redistribute it, and to use it for any
  8. ;;;    purpose is granted, subject to the following restrictions and
  9. ;;;    understandings.
  10. ;;;
  11. ;;;    1. Any copy made of this software must include this copyright
  12. ;;;    notice in full.
  13. ;;;
  14. ;;;    2. Users of this software agree to make their best efforts (a)
  15. ;;;    to return to the MIT Scheme project any improvements or
  16. ;;;    extensions that they make, so that these may be included in
  17. ;;;    future releases; and (b) to inform MIT of noteworthy uses of
  18. ;;;    this software.
  19. ;;;
  20. ;;;    3.  All materials developed as a consequence of the use of
  21. ;;;    this software shall duly acknowledge such use, in accordance
  22. ;;;    with the usual standards of acknowledging credit in academic
  23. ;;;    research.
  24. ;;;
  25. ;;;    4. MIT has made no warrantee or representation that the
  26. ;;;    operation of this software will be error-free, and MIT is
  27. ;;;    under no obligation to provide any services, by way of
  28. ;;;    maintenance, update, or otherwise.
  29. ;;;
  30. ;;;    5.  In conjunction with products arising from the use of this
  31. ;;;    material, there shall be no use of the name of the
  32. ;;;    Massachusetts Institute of Technology nor of any adaptation
  33. ;;;    thereof in any advertising, promotional, or sales literature
  34. ;;;    without prior written consent from MIT in each case.
  35. ;;;
  36. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  37. ;;;
  38. ;;;     Modified by Texas Instruments Inc 8/15/85
  39. ;;;
  40. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  41.  
  42.  
  43. (define char<=
  44.    (lambda (a1 c e1)
  45.       (and (char<=? a1 c)
  46.            (char<=? c e1))))
  47.  
  48. (define (char-set-member? char-set char)
  49.   (substring-find-next-char-in-set char-set 0 (string-length char-set) char))
  50.  
  51. ;;; Character Sets
  52.  
  53. (define char-set:whitespace
  54.   (make-char-set #\Space #\Newline
  55.         #\Tab #\Return #\Page
  56.         ))
  57.  
  58. (define char-set:not-whitespace
  59.   (char-set-invert char-set:whitespace))
  60.  
  61. (define char-set-predicate
  62.   (lambda (char-set)
  63.     (let ((len (string-length char-set)))
  64.       (lambda (char)
  65.         (substring-find-next-char-in-set char-set 0 len char)))))
  66.  
  67. (define char-whitespace? (char-set-predicate char-set:whitespace))
  68.  
  69. (define char-set:alphabetic
  70.   (predicate->char-set
  71.     (lambda (char)
  72.       (or (char<= #\A char #\Z)
  73.           (char<= #\a char #\z)))))
  74.  
  75. (define char-alphabetic? (char-set-predicate char-set:alphabetic))
  76.  
  77. (define char-set:alphanumeric
  78.   (predicate->char-set
  79.     (lambda (char)
  80.       (or (char<= #\0 char #\9)
  81.           (char<= #\A char #\Z)
  82.           (char<= #\a char #\z)))))
  83.  
  84. (define char-set:graphic
  85.   (char-set-union char-set:alphanumeric
  86.           (make-char-set #\! #\" #\# #\$ #\% #\& #\' #\( #\) #\*
  87.                 #\+ #\, #\- #\. #\/ #\: #\; #\< #\= #\>
  88.                 #\? #\@ #\[ #\\ #\] #\^ #\_ #\` #\{ #\|
  89.                 #\} #\~ #\Space)))
  90.  
  91. (define char-graphic? (char-set-predicate char-set:graphic))
  92.  
  93. (define sexp-delims (make-char-set #\( #\)))
  94.  
  95. (define char-set:blanks (make-char-set #\Space #\Tab))
  96. (define char-blank? (char-set-predicate char-set:blanks))
  97. (define char-set:non-blanks (char-set-invert char-set:blanks))
  98. ;define find-next-blank (char-set-forward-search char-set:blanks))
  99. ;define find-previous-blank (char-set-backward-search char-set:blanks))
  100.  
  101. (define word-constituent-chars
  102.   (char-set-union char-set:alphanumeric
  103.           (make-char-set #\$ #\% #\.)))
  104.  
  105. (define word-delimiter-chars
  106.   (char-set-invert word-constituent-chars))
  107.  
  108. (define sexp-constituent-chars
  109.   (char-set-union char-set:alphanumeric
  110.         (make-char-set #\! #\$ #\% #\* #\/ #\: #\< #\= #\> #\? #\_
  111.                        #\- #\+ #\~ #\@ #\# #\^)))
  112.  
  113. (define sexp-delimeter-chars (char-set-invert sexp-constituent-chars))
  114.  
  115. (define char-set-sexp? (char-set-predicate sexp-constituent-chars))
  116.  
  117.  
  118. (define non-graphic-chars (make-non-graphic-char-set))
  119.  
  120.  
  121.  
  122.